home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / TIMING.SWG / 0003_Time Code Segments.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  3KB  |  130 lines
  1.  {$G+,S-,R-,Q-}
  2.  program timer;
  3.  
  4.  { Program to time short segments of code; inspired by Michael Abrash's
  5.    Zen timer.  Donated to the public domain by D.J. Murdoch }
  6.  
  7.  uses
  8.    opdos; { Object Professional unit, needed only for TimeMS,
  9.             a millisecond timer. }
  10.  
  11.  const
  12.    onetick = 1/33E6;  { This is the time in seconds for one cpu cycle.
  13.                         I've got it set for a 33 Mhz machine. }
  14.  
  15.  { Instructions:  put your code fragment into a short routine called Segment.
  16.    It should leave the stack unchanged, or it'll blow up when we clone it.
  17.    It *must* have a far return at the end.  Play around with declaring it
  18.    as an assembler procedure or not to see the cost of the TP entry and
  19.    exit code. }
  20.  
  21.  { This example is Sean Palmer's "var2 := var1 div 2" replacement fragment. }
  22.  
  23.  var
  24.    var1,var2 : integer;
  25.  
  26.  procedure Segment; far; assembler;
  27.  asm
  28.     mov ax,var1
  29.     sar ax,1
  30.     jns @S
  31.     adc ax,0
  32.   @S:
  33.     mov var2,ax
  34.  end;
  35.  
  36.  { This is the comparison TP code.  Note that it includes entry/exit code;
  37.    play around with variations on the assembler version to make it a fair
  38.    comparison }
  39.  (*
  40.  procedure Segment; far;
  41.  begin
  42.    var2 := var1 div 2;
  43.  end;
  44.  *)
  45.  
  46.  { This procedure is essential!!! Do not move it. It must follow
  47.    Segment directly. }
  48.  procedure Stop;
  49.  begin
  50.  end;
  51.  
  52.  { This routine will only be called once at the beginning of the program;
  53.    set up any variables that Segment needs }
  54.  
  55.  procedure Setup;
  56.  begin
  57.    var1 := 5;
  58.    writeln('This run, var1=',var1);
  59.  end;
  60.  
  61.  const
  62.    maxsize=65520;
  63.    RETF   = $CB;
  64.  var
  65.    p : pointer;
  66.    src,dest : ^byte;
  67.    size : word;
  68.    repeats : word;
  69.    i : word;
  70.    start,finish : longint;
  71.    count : longint;
  72.    main,overhead,millisecs : real;
  73.  begin
  74.  
  75.    setup;
  76.  
  77.    { Get a segment of memory, and fill it up with as many copies
  78.      of the segment as possible }
  79.  
  80.    size := ofs(stop) - ofs(Segment) -1;
  81.    repeats := maxsize div size;
  82.    getmem(p, size*repeats + 1);
  83.    src := @Segment;
  84.    dest := p;
  85.    for i:=1 to repeats do
  86.    begin
  87.      move(src^,dest^,size);
  88.      inc(dest,size);
  89.    end;
  90.    { Add a final RETF at the end. }
  91.    dest^ := RETF;
  92.  
  93.    { Now do the timing.  Keep repeating one second loops indefinitely. }
  94.  
  95.    writeln(' Bytes     Clocks       ns       MIPS');
  96.    repeat
  97.      { First loop:  one second worth of calls to the segment }
  98.      start := timems;
  99.      count := 0;
  100.      repeat
  101.        asm
  102.          call dword ptr p
  103.        end;
  104.        finish := timems;
  105.        inc(count);
  106.      until finish > 1000+start;
  107.      main := (finish - start)/repeats/count;
  108.  
  109.      { Second loop:  1/2 second worth of calls to the RETF }
  110.      start := timems;
  111.      count := 0;
  112.      repeat
  113.        asm
  114.          call dword ptr dest
  115.        end;
  116.        finish := timems;
  117.        inc(count);
  118.      until finish > 500+start;
  119.      overhead := (finish-start)/count;
  120.      millisecs := (main-overhead/repeats);
  121.      writeln(size:6,millisecs/1000/onetick:11:1,
  122.                     1.e6*millisecs:11:0,
  123.                     1/millisecs/1000:11:3);
  124.    until false;
  125.  end.
  126.  
  127.  
  128. --- Msg V3.2
  129.  * Origin: Murdoch's Point, Kingston, Ont, Canada  - -   (1:249/99.5)
  130.